The World's Largest Collection of Windows Software

home *** CD-ROM | disk | FTP | other *** search

/ The World's Largest Collection of Windows Software / The World's Largest Collection of Windows Software - Disc 1.iso / connect / _b1 / mrun211 / mrun211e.was < prev next >

Wrap

Text File | 1993-05-01 | 19.6 KB | 745 lines

;MailRun v2.11: Part E, addulfile ;1992-1993 Gerald P. Sully, all rights reserved. #comment ************************************************************************** ************************************************************************** * * This file contains routines related to adding a "Upload File" * item to a mailrun. It puts up the Upload Files dialog box, * which displays the contents of the available files index (the * *.udx file for the mailrun). When a file is selected from the * list, a detailed description is displayed from the *.ubf file * for the mailrun). * ************************************************************************** ************************************************************************** #endcomment #define MRUN211E #define MRUN211DE #include "mrun211.h" string DXFileTabs, OldUDX, OldUBF, MRunUDX, MRunUBF, LastChoice string UploadDir, DownloadDir, BBSChoice integer InULDir, ULSortField #comment ********************************************************************* * * MAIN() * * Calls checkchild(), updateudx(), interfaceon(), getnewdesc(), * getulfiles(), checkchanged(), getlastitem(), gettaskstring(), * clearfiledesc(), makebbslist(), ulfilebox(), insertulfile(), * delulfile(), menudim(), makefullname(), sortidx(), checkfile() * * Adds a SendFile item to the mailrun. An feditbox is * used to display the file description in order to take * advantage of wordwrap. The flistbox displays the * contents of MAILRUN.UDX, which contains information on * any file downloaded by MailRun, plus additional files * found in the upload directory. A file description must * be at least 6 characters, but may be as long as needed. * ********************************************************************* #endcomment proc main string FullFileName, char, temp integer dialogstatus integer j, InUDX menudim() checkchild() findfirst MailRun MailRunTrunc = $FILENAME DXFileTabs = "58,92,130,305,315,319,322,325,328" profilerd MailRun "MailRun" "UploadDir" UploadDir profilerd MailRun "MailRun" "DownloadDir" DownloadDir profilerd MailRun "MailRun" "ULSortField" ULSortField strextract BBSChoice TaskItem "`t" 3 strextract char TaskItem "`t" 4 atoi char j FileDesc = makefullname(TempDir, "DESC.TMP") OldUDX = makefullname(TempDir, "OLDUDX.TMP") OldUBF = makefullname(TempDir, "OLDUBF.TMP") MRunUDX = makefullname(MailRunDir, "MAILRUN.UDX") MRunUBF = makefullname(MailRunDir, "MAILRUN.UBF") if isfile FileDesc delfile FileDesc endif if not (checkfile(MRunUDX) && checkfile(MRUNUBF)) getulfiles() endif LastChoice = "" FLAGS &= UNCHANGED interfaceon() makebbslist() ulfilebox() dialogstatus = $DIALOG while dialogstatus != 1 switch dialogstatus case 10 ;User selected "Add" insertulfile(&j) TaskItem = gettaskstring(BBSChoice, j) endcase case 11 ;User selected "Save" if FLAGS & CHANGED updateudx() FLAGS &= UNCHANGED updatedlg -1 endif endcase case 12 ;User selected "Delete" delulfile() endcase case 13 ;User selected "Refresh" statmsg "Refreshing Uploads List from Upload Directory..." getulfiles() updatedlg -1 statmsg "" endcase case 50 ;User selected a sort radiobutton profilewr MailRun "MailRun" "ULSortField" ULSortField sortidx(MRunUDX, ULSortField) updatedlg 16 endcase case 130 ;User selected a file from the listbox if checkchanged() getnewdesc() updatedlg 137 else FileChoice = LastChoice updatedlg 16 endif endcase case 170 ;User changed BBSs with the combobox j = getlastitem(BBSChoice) TaskItem = gettaskstring(BBSChoice, j) endcase case 230 ;User entered a name in the File Name box FullFileName = makefullname(UploadDir, FileName) if isfile FullFileName InULDir = 1 else InULDir = 0 endif interfaceoff() openfile(MRunUDXFile, MRunUDX, _READWRITE, _TEXT) InUDX = checkudx(FileName) if InUDX fseek MRunUDXFile -100 1 fgets MRunUDXFile FileChoice fgets MRunUDXFile FileChoice strextract temp FileChoice "`t" 0 while not strcmpi temp FileName fgets MRunUDXFile FileChoice strextract temp FileChoice "`t" 0 endwhile endif fclose MRunUDXFile interfaceon() if InUDX makedesc(MRunUBF) else clearfiledesc() endif updatedlg -1 endcase case 250 ;User entered a file description if !(FLAGS & CHANGED) FLAGS |= CHANGED endif endcase endswitch dialogstatus = $DIALOG endwhile endproc #comment ********************************************************************* * * INSERTULFILE() * * Called by main() * * Calls openfile(), updateudx(), insertitem(), * interfaceon(), interfaceoff(), makefullname(), checkudx(), * clearfiledesc(), shortdesc() * * Adds a SendFile item to the *.MRN file and the task list. * ********************************************************************* #endcomment proc insertulfile intparm j string ULDescString, ULFileString, FullFileName string ULFileSpec, StatString, CopyboxMsg integer ULDescLength, Perm, Response, InUDX interfaceoff() if NULLSTR FileName ;User hasn't selected a file usermsg "You must select a file first." return endif if InULDir == 0 strupr FileName strfmt CopyBoxMsg \ "%s is not in the Upload Directory.`r`nCopy it now?" \ FileName strlwr FileName sdlgmsgbox "MailRun Message" CopyBoxMsg QUESTION \ OKCANCEL Response 1 switch Response case 1 ;User selected "OK" ULFileSpec = makefullname(DownloadDir, FileName) dir ULFileSpec FullFileName if NULLSTR FullFileName return endif if not isfile FullFileName sdlgmsgbox "MailRun Message" "No such file!" \ EXCLAMATION OK Response 1 return endif copyfile FullFileName UploadDir if not strcmpi ULFileSpec FullFileName ;if the user chose a file other than the one specified ;get the name of the file findfirst FullFileName FileName = $FILENAME strlwr FileName ;determine whether it is already in the uploads database openfile(MRunUDXFile, MRunUDX, _READWRITE, _TEXT) InUDX = checkudx(FileName) fclose MRunUDXFile if InUDX == 0 ;if it isn't in the uploads database, put it there clearfiledesc() FLAGS |= CHANGED updateudx() endif endif InULDir = 1 updatedlg -1 endcase case 2 ;User selected "Cancel" return endcase endswitch endif ;No description may be less than 6 characters openfile(FileDescFile, FileDesc, _READWRITE, _NORMAL) fread FileDescFile ULDescString 65 ULDescLength fclose FileDescFile if ULDescLength < 6 usermsg "Please enter a longer description." elseif shortdesc(ULDescString, ULDescLength) ;If everything is OK... if FLAGS & CHANGED ;Add the new description to the database updateudx() FLAGS &= UNCHANGED updatedlg 16 endif Perm = 2 - PermRadio strupr FileName strfmt ULFileString \ "1,%d,SendFile,%s,%s" Perm FileName Conf strfmt StatString \ "Added to %s: `"Upload %s to Conference %s`"" \ BBSChoice FileName Conf j++ insertitem(BBSChoice, j, ULFileString) strlwr FileName statmsg StatString endif interfaceon() endproc #comment ********************************************************************* * * SHORTDESC() * * Called by insertulfile() * * Calls findstring() * * If the current BBS type is WildCat! or RBBS, limits the * upload description length to 60 or 45 characters, * respectively. Gives user an opportunity to enter a new * description if the current one is too long. * ********************************************************************* #endcomment func shortdesc : integer strparm ULDescString intparm ULDescLength string ULMsg, TypeName integer Response, MaxLength profilerd MailRun BBSChoice "BBSType" BBSType if (findstring(BBSType, "WildCat") && (ULDescLength > 60)) || \ (findstring(BBSType, "RBBS") && (ULDescLength > 45)) if findstring(BBSType, "WildCat") substr ULDescString ULDescString 0 60 MaxLength = 60 TypeName = "WildCat!" else substr ULDescString UlDescString 0 45 MaxLength = 45 TypeName = "RBBS" endif strfmt ULMsg "A %s file description has a maximum length \ of %d characters. The description for %s will be truncated to read:\ `r`n`r`n%s`r`n`r`nDo you wish to continue?" \ TypeName MaxLength FileName ULDescString sdlgmsgbox "MailRun Message" ULMsg QUESTION YESNO Response 2 switch Response case 6 return 1 endcase case 7 return 0 endcase endswitch else return 1 endif endfunc #comment ********************************************************************* * * DELULFILE() * * Called by main() * * Calls killfile(), makefullname() * * Deletes a file from the upload database index. * ********************************************************************* #endcomment proc delulfile string DelBoxMsg, FullFileName integer Response if not NULLSTR FileName if InULDir == 1 ;If the selected file is in the upload directory strfmt DelBoxMsg "Delete file %s as well?" FileName sdlgmsgbox "MailRun Message" DelBoxMsg QUESTION \ YESNOCANCEL Response 1 switch Response case 2 ;User selected "Cancel" return endcase case 6 ;User selected "Yes" FullFileName = makefullname(UploadDir, FileName) delfile FullFileName case 7 ;User selected "No" killfile() endcase endswitch else killfile() endif FLAGS &= UNCHANGED updatedlg -1 endif endproc #comment ********************************************************************* * * KILLFILE() * * Called by delulfile() * * Calls openfile(), clearfiledesc(), getnewdesc() * * Deletes a file from the upload database index. * ********************************************************************* #endcomment proc killfile string UDXString, UDXFile, temp ;Copy all but the new description to the new UDX file copyfile MRunUDX OldUDX openfile(OldUDXFile, OldUDX, _READWRITE, _TEXT) openfile(MRunUDXFile, MRunUDX, _CREATE, _TEXT) fgets OldUDXFile UDXString while not feof OldUDXFile ;Read lines until the end of file or the current file strextract UDXFile UDXString "`t" 0 if strcmpi UDXFile FileName exitwhile endif fputs MRunUDXFile UDXString fgets OldUDXFile UDXString endwhile fgets OldUDXFile UDXString ;get the new listbox selection FileChoice = UDXString while not feof OldUDXFile fputs MRunUDXFile UDXString fgets OldUDXFile UDXString endwhile if NULLSTR FileChoice ;if the deleted line was the last in the file ;back up one line and read it fseek MRunUDXFile -100 2 fgets MRunUDXFile temp while not NULLSTR temp FileChoice = temp fgets MRunUDXFile temp endwhile endif if not NULLSTR FileChoice getnewdesc() else FileName = "" clearfiledesc() endif fclose OldUDXFile fclose MRunUDXFile delfile OldUDX endproc #comment ********************************************************************* * * GETNEWDESC() * * Called by main(), killfile() * * Calls makedesc(), makefullname() * * Gets the file name and description from the index entry * and determines whether the file is in the upload directory. * ********************************************************************* #endcomment proc getnewdesc string FullFileName LastChoice = FileChoice strextract FileName FileChoice "`t" 0 FullFileName = makefullname(UploadDir, FileName) if isfile FullFileName InULDir = 1 else InULDir = 0 endif makedesc(MRunUBF) endproc #comment ********************************************************************* * * GETULFILES() * * Called by main() * * Calls openfile(), checkudx(), checkfile(), sortidx(), * interfaceon(), interfaceoff(), makefullname() * * Updates the Upload directory file description database. * ********************************************************************* #endcomment proc getulfiles string FileSize, FileDate, FDesc, DescBegin, DescLength, UDXString string ULFileFull, ULFileTrunc, FullFileName long FS, DB, DL, NDB, counter integer char integer InUDX interfaceoff() if checkfile(MRunUDX) && checkfile(MRunUBF) copyfile MRunUDX OldUDX copyfile MRunUBF OldUBF openfile(OldUDXFile, OldUDX, _READWRITE, _TEXT) openfile(OldUBFFile, OldUBF, _READWRITE, _NORMAL) else openfile(OldUDXFile, OldUDX, _CREATE, _TEXT) openfile(OldUBFFile, OldUBF, _CREATE, _NORMAL) endif openfile(MRunUDXFile, MRunUDX, _CREATE, _TEXT) openfile(MRunUBFFile, MRunUBF, _CREATE, _NORMAL) fgets OldUDXFile UDXString while not feof OldUDXFile ;loop through the old .UDX file ;extract all fields strextract ULFileTrunc UDXString "`t" 0 strextract FileSize UDXString "`t" 1 strextract FileDate UDXString "`t" 2 strextract FDesc UDXString "`t" 3 strextract DescBegin UDXString "`t" 4 strextract DescLength UDXString "`t" 5 atol DescBegin DB atol DescLength DL ftell MRunUBFFile NDB ;go to the beginning of the file description fseek OldUBFFile DB 0 ;copy the description to the new .UBF file for counter = 1 upto DL fgetc OldUBFFile char fputc MRunUBFFile char endfor ;add the index line to the new .UDX file fstrfmt MRunUDXFile "%s`t%s`t%s`t%s`t%ld`t%ld`r`n" \ ULFileTrunc FileSize FileDate FDesc NDB DL fgets OldUDXFile UDXString endwhile ;Add any new files found in the uploads directory FullFileName = makefullname(UploadDir, "*.*") findfirst FullFileName while FOUND ;Loop through all files in the upload directory ULFileTrunc = $FILENAME InUDX = checkudx(ULFileTrunc) if InUDX == 0 ULFileFull = makefullname(UploadDir, ULFileTrunc) getfsize ULFileFull FS getfdate ULFileFull FileDate strlwr ULFileTrunc fseek MRunUDXFile 0 2 fstrfmt MRunUDXFile "%s`t%ld`t%s`t`t0`t0`r`n" \ ULFileTrunc FS FileDate endif findnext endwhile fclose MRunUDXFile fclose MRunUBFFile fclose OldUDXFile fclose OldUBFFile delfile OldUDX delfile OldUBF interfaceon() sortidx(MRunUDX, ULSortField) endproc #comment ********************************************************************* * * CHECKUDX() * * Called by insertulfile(), getulfiles() * * Checks whether a given file is already in the UDX List. * If it is, a value of 1 is returned, if not, the file * is added to the list and a value of 0 is returned. * ********************************************************************* #endcomment func checkudx : integer strparm CkFileName string UDXFile, UDXFileString integer InUDX rewind MRunUDXFile InUDX = 0 fgets MRunUDXFile UDXFileString while not feof MRunUDXFile strextract UDXFile UDXFileString "`t" 0 if strcmpi CkFileName UDXFile InUDX = 1 exitwhile endif fgets MRunUDXFile UDXFileString endwhile return InUDX endfunc #comment ********************************************************************* * * UPDATEUDX() * * Called by main(), insertulfile() * * Calls openfile(), interfaceon(), interfaceoff(), * makefullname(), sortidx() * * Updates the Upload directory file description database * and index files. * ********************************************************************* #endcomment proc updateudx string FileDate, FileSize, FullFileName string ULDescString, UDXString, UDXFile long DescBegin, DescLength, l integer ULDescLength integer char interfaceoff() ;Copy all but the new description to the new UDX file copyfile MRunUDX OldUDX openfile(OldUDXFile, OldUDX, _READWRITE, _TEXT) openfile(MRunUDXFile, MRunUDX, _CREATE, _TEXT) fgets OldUDXFile UDXString while not feof OldUDXFile ;Read lines until the end of file or the current file strextract UDXFile UDXString "`t" 0 if strcmpi UDXFile FileName exitwhile endif fputs MRunUDXFile UDXString fgets OldUDXFile UDXString endwhile ;Get the size and date if NULLSTR UDXString FullFileName = makefullname(UploadDir, FileName) if isfile FullFileName getfsize FullFileName l ltoa l FileSize getfdate FullFileName FileDate InULDir = 1 else FileSize = "???" FileDate = "??/??/??" InULDir = 0 endif else strextract FileSize UDXString "`t" 1 strextract FileDate UDXString "`t" 2 endif ;Discard the old description line fgets OldUDXFile UDXString FileChoice = UDXString while not feof OldUDXFile fputs MRunUDXFile UDXString fgets OldUDXFile UDXString endwhile openfile(MRunUBFFile, MRunUBF, _READWRITE, _NORMAL) ;go to the end of the description database fseek MRunUBFFile 0 2 ftell MRunUBFFile DescBegin DescLength = 0 ULDescLength = 0 ULDescString = "" ;read characters from the description box into the database openfile(FileDescFile, FileDesc, _READWRITE, _NORMAL) fgetc FileDescFile char while not feof FileDescFile ;read characters until all have been read if ((char >= 0x20) && (char <= 0x7E)) || \ ((char >= 0xA0) && (char <= 0xFE)) ;Ignore non-printing characters fputc MRunUBFFile char if ULDescLength < 46 ;No special characters in the index file either strfmt ULDescString "%s%c" ULDescString char ULDescLength++ endif DescLength++ endif fgetc FileDescFile char endwhile fclose MRunUBFFile fclose FileDescFile ;Strip partial words from end of description if ULDescLength == 46 ULDescLength-- strpeek ULDescString ULDescLength char while char > 32 strdelete ULDescString ULDescLength 1 ULDescLength-- strpeek ULDescString ULDescLength char endwhile endif strfmt FileChoice "%s`t%s`t%s`t%s`t%ld`t%ld" \ FileName FileSize FileDate ULDescString DescBegin DescLength fputs MRunUDXFile FileChoice fclose OldUDXFile fclose MRunUDXFile delfile OldUDX sortidx(MRunUDX, ULSortField) interfaceon() endproc #comment ********************************************************************* * * ULFILEBOX() * * Called by main() * * Draws the Upload Files Dialog Box. * ********************************************************************* #endcomment proc ulfilebox PermRadio = 2 Conf = "0" FileName = "" destroydlg HelpPage = 10 dialogbox 19 38 324 201 15 "Upload Files" HELPID HelpPage text 12 27 56 8 left "Filename" text 70 27 40 8 left "Size" text 104 27 34 8 left "Date" text 142 27 117 8 left "Description" flistbox 12 38 300 50 MRunUDX DXFileTabs single FileChoice groupbox 12 89 300 17 radiobutton 26 94 60 11 "Unsorted" ULSortField radiobutton 91 94 67 11 "Sort by Name" radiobutton 172 94 61 11 "Sort by Size" radiobutton 241 94 62 11 "Sort by Date" endgroup text 13 112 49 8 left "Filename:" editbox 12 122 101 12 FileName text 129 112 67 8 left "Description:" feditbox 129 122 182 50 FileDesc text 14 158 78 8 right "U/L to Conference:" editbox 96 156 16 12 Conf radiobutton 12 178 53 13 "Permanent" PermRadio radiobutton 70 178 54 13 "Temporary" endgroup pushbutton 130 179 30 14 "&Add" normal default pushbutton 168 179 30 14 "&Save" normal pushbutton 206 179 30 14 "De&lete" normal pushbutton 244 179 30 14 "&Refresh" normal pushbutton 282 179 30 14 "&Done" cancel text 76 9 80 8 right "Upload File to:" combobox 160 7 70 42 BBSList BBSChoice sort checkbox 13 140 100 10 "File in uploads directory?" InULDir enddialog disable CTRL 70 endproc